perm filename RESPC.F4[PAG,LCS]14 blob sn#502591 filedate 1980-03-26 generic text, type T, neo UTF8
	SUBROUTINE RESPC
C  RQ(2) IS R4, RQ(3) IS R5 ETC.
	COMMON/STF/RSTFAC(8),RSTJ2 /POSI/STFF(8),JJ2,JPQ
	1 /IPG/IPG,JPG,BRACK(0/7),RSTNUM(8),RPSZ(8),RHGT(8),
	1 RCLEF(0/7) /IVV/IV(1)
	COMMON RS,JA,REST,J2,RQ(18),JX,PR,LX,RDIS
C  ORDER OF COMMON BLOCKS **MUST** STAY AS IS!
	COMMON/XRN/RN(1) /SF/KL,RT,KP,STFSZ,NAMX
	1 /PTR/KWDS(1)/LLL/L,LL,I,IX/XXX/LK,LP,JY /JN/J,N
C  INCREASE DIMENSION OF KWDS FOR VERY FULL PAGES.
      DIMENSION NRD(100),MM(1500),NN(1500),BARS(509),E(100),F(100),
	1 G(100),H(100),KPN(1),HH(100),HHH(100),DUMMY(100),PGTRN(500)
	INTEGER DUMMY
	COMMON /PX/PN(1) /Q/Q(1)
	1 /RCLF/KK,CLEF,KW,ITEM,RSTAFF,SN,YN,RNAM,RNAM2,RNAM3
	1 /KBAR/KBAR(1) /RSP/KNM(1) /ENDL/ENDLN,KQ,NAME,NMPG,SPCNT
	EQUIVALENCE (RQ(2),R4),(R5,RQ(3)),(R6,RQ(4)),(R7,RQ(5)),(MM,RN)
	1,(NN,RN(501)),(KPN,PN),(KS,RS),(BARS,KBAR(4)),(HHH,RN(2250))
	1,(R8,RQ(6)),(R9,RQ(7)),(RQ(10),XLFT),(KBR,KBAR),(T,KBAR(2))
	1,(LASTNM,KBAR(3)),(LCNT,IV(45)),(NDPY,IV(46)),(HH,RN(1250))
	1,(E,RN(1000)),(F,RN(2500)),(G,RN(2700)),(H,RN(2850))
	1,(DUMMY,RN(1400)),(PGTRN(1),KBAR(516))
	DATA FIB/.8/  ,RSPC/28./,PGNUM/1.6/,RNMHT/16.0/,RNMSZ/1.2/
	1 ,RLTRSZ/1.0/,SPCPG/2.7/,SPCRX/1.5/ ,BFAC/0.7/,ACCISZ/1.0/
C  RSPC=28 SEEMS TO BE ARBITRARY. SPCRX USED IN RHYTH RESPACE.

	IF(NMPG.NE.'PAGEA')GO TO 2000
C SHOULD HANDLE UP TO 104 INPUT FILES.  ADD HERE AND LATER FOR MORE RANGE.
	RNEXT=0
2000	SPCNT=1.0
	JX=0
	JCEN=0
C  FLAG FOR CENTERED RESTS.
	XT=0
	JK=1
C JK IS USED AT END.  IN SECTION TO FIND SIZE FACTOR FOR EACH BAR.
	PX=0
	CALL SHFT1(KQ)
	KK=L
CC	TYPE 3001,L
C  DELETES EXTRA BAR LINES, ETC.
	IF(IPG)CALL RESTS
C???	IF(N)RETURN 
C N IS NEG., ONLY RESTS WERE ON THIS LINE. (WHAT ABOUT LAST LINE???)
C  FROM NOW ON ALL CODES #-1 ARE IGNORED, RESTS HAVE BEEN COMBINED.
	CALL SHIFT
C  L=NUMBER OF ITEMS FOR RHY RECONS.
	JJ2=L+2
C FOR WDCNT IN .PAG FILE
	IF(IPG.EQ.2)GO TO 11
C IPG=2=REORDER INPUT FILE ONLY.
	N=0
	S=-100
	R=0
	KCLEF=0
	NOGRCE=-1
C  GRACE NOTE FLAG
	TTT=0
C FOR IRREG. NUMS. OF STAVES.

C******** BIG LOOP ***************
161	DO 601 K=1,L
	R=CODEN(KPN,K,Q,J)
	RZ=Q(J)
CX	J=KPN(K)
CC	N=N+1
CC	NN(N)=0
CC	MM(N)=J+3
	CALL MMNN(3)
	NN(N)=-R
C MAKE ALL CODE NUMS NEG. AT FIRST.  CHANGE 1,2,3,4,17,18 LATER
CX	R=Q(J+1)
	IF(R.GT.2)GO TO 1801
	IF(Q(J+2).GT.TTT)TTT=Q(J+2)
C FINDS HIGHEST STAFF NUM.  NOW WE CAN HAVE IRREG. NUMS. OF STAVES.
	IF(R.NE.1)GO TO 2801
	IF(RZ.LT.7)GO TO 601
	IF(Q(J+9).LE.0)GO TO 601
C P9=-1 FOR NOTES WITHOUT LEDGER LINES (HENCE NO RHYTHM.)
	IF(Q(J+9).NE.4./88.)GO TO 702
CC	IF(Q(J+9).GT..05)GO TO 702
CC	IF(Q(J+8).EQ.1000)GO TO 601
C  SKIP GRACE NOTE, OR NOTES WITHOUT RHY., OR .LT.1/88 NOTES.
	NOGRCE=0
	GO TO 601
CCC2801	IF(R.NE.2)GO TO 1801
2801	RS=Q(J+7)
	IF(RZ.LT.7)GO TO 3801
C DELETE ALL UP TO LABEL 1801 LATER.  NEW CENTERED REST FEATURE. 5/29/78
CXX	NN(N)=-NN(N)
	IF(Q(J+9).NE.0)Q(J+9)=-1
C  SET UP WHOLE REST CENTERING. (P9=-1 CAUSES CENTERING AT OUTPUT TIME.)
	IF(Q(J+8).EQ.0)GO TO 601
C SKIP IF WHOLE REST OVER CUE NOTES. (P8=0)
	IF(RS.LE.0)GO TO 601
C SKIP RESTS WITH NO RHYTHM VALUE IN P7
	GO TO 702
C??? NOW MAKE CODE NUM. POS.
CC	NN(N)=R
CC	GO TO 688
3801	IF(RZ.LT.5)GO TO 601
	IF(RS.LE.0)GO TO 601
	IF(IPG)GO TO 702
	IF(RZ.LT.6)GO TO 702
	IF(Q(J+6))GO TO 702
C PARAM 6=-1 = INVISIBLE. SHOULDN'T BE WHOLE REST (P8) ANYWAY.
	RS=Q(J+3)
C GET POS. OF CENTERED WHOLE REST
	TT=0
	B=Q(J+2)
C GET THE STAFF NUM.
	DO 602 M=1,L
	T=CODEN(KPN,M,Q,JJ)
	A=Q(JJ+3)
C GET POS. OF ITEM
	IF(A.GT.RS)GO TO 602
C JUMP IF ITEM IS TO RIGHT OF REST
	IF(T.NE.4)GO TO 602
C IS THE ITEM A BAR LINE
	IF(Q(JJ+4).LT.0)GO TO 602
C**** SKIP IF INVIS. BAR (P4=-1)
	IF(A.GT.TT)TT=A
C FINDS BAR LINE CLOSEST TO LEFT OF REST
602	CONTINUE
C NOW T HAS POS OF CLOSEST BAR, KSIG OR METER TO LEFT OF REST
	T=20000
	A=20000
C NOW FIND NOTE OR REST CLOSEST TO RIGHT OF BAR, ETC.
	DO 613 M=1,L
	IF(CODEN(KPN,M,Q,JJ).GT.2)GO TO 613
	IF(Q(JJ).LT.7)GO TO 609
C SKIP IF RHYTH NOT IN P9
	IF(Q(JJ+9).LT..05)GO TO 613
C IGNORES GRACE NOTES. ****** THERE COULD BE SOME RARE PROBLEMS HERE *****
609	B=Q(JJ+3)
C POS. OF ITEM
	X=B-TT
	IF(X)GO TO 613
C JUMP IF ITEM IS TOO FAR TO LEFT
	IF(X.GT.A)GO TO 613
	A=X
	T=B
C T = POS OF NOTE OR REST NEAREST BAR, ETC.
613	CONTINUE
	IF(T.NE.20000)GO TO 612
C JUMP IF NOTE OR REST FOUND
	JCEN=-1
	GO TO 1801
612	Q(J+3)=T
C THE REST IS NOW MOVED NEAR TO BAR, PROPER POS.
C  MUST ALIGN REST WITH FIRST RHYTH ON OTHER STAFF.
C  THIS WILL IGNORE WHOLE RESTS IN CENTER OF MEASURE.
1801	IF(R.LT.4)GO TO 702
	IF(R.EQ.17)GO TO 1702
	IF(R.EQ.18)GO TO 1702
	IF(R.EQ.10)GO TO 702
C FOUND A NUMBER.  USE THIS IN RESTP
	IF(R.LE.7)GO TO 30
	IF(R.NE.44)GO TO 601
	IF(RZ.EQ.2)GO TO 601
C RZ=2= BAR LINE ON UPPER STAFF
	IF(Q(J+6).EQ.0)GO TO 601
	IF(Q(J+5).EQ.0)GO TO 601
C  GETS LEFT END OF LINES, CRESC., DASHES.
	GO TO 604
30	IF(R.NE.7)GO TO 605
	IF(RZ.LT.5)GO TO 604
C JUMP FOR STANDARD TRILL
	RS=Q(J+7)
	IF(RS.EQ.1)GO TO 604
	IF(ABS(RS).GE.3)GO TO 604
C JUMP FOR 8VA, 15MA, ELSE THIS IS A PEDAL MARK WITHOUT LINE.
	GO TO 601
605	IF(R.NE.4)GO TO 604
	IF(Q(J+4).LT.0)GO TO 601
C*** SKIP IF INVIS. BAR (P4=-1)
	IF(RZ.LE.3)GO TO 702
C JUMP IF IT IS A BAR LINE
CC	IF(RZ.LT.4)GO TO 601
	IF(Q(J+6).NE.0)GO TO 604
C GO GET OTHER POS OF LINE
	GO TO 601
1702	IF(Q(J+4).NE.0)GO TO 601
	IF(Q(J+2).NE.0)GO TO 601
C IGNORE METER NOT IN VERT. POS. 0. (PUT IN OTHER PROGS!)
702	NN(N)=-NN(N)
CC702	NN(N)=R 
	GO TO 601
C NEXT FOR MULTIPOSITION ITEMS: LINES, SLURS, BEAMS, TRILL, 8VA
604	CALL MMNN(6)
C NEXT POS2, 3 AND 4 OF CERTAIN ITEMS  (PUTS -1 INTO NN(X))
CCXX	NN(N)=-1

	IF(R.NE.6)GO TO 601
C NEXT FOR BEAMS
	IF(RZ.LT.8)GO TO 608
	IF(Q(J+10).EQ.0)GO TO 608
	IF(Q(J+8))GO TO 608
C P8<0 = P8=P3 (PARTIAL BEAM TO LEFT)
	IF(Q(J+7).GT.0)CALL MMNN(8)
C NEXT SHIFTS P8 OF COMPOSITE BEAMS
608	IF(RZ.LT.7)GO TO 601
	IF(Q(J+7))GO TO 688
C  P7 IS NEG FOR TREMOLO
	IF(Q(J+8).EQ.0)GO TO 601
C P8 NEG OR POS = POS3 IN P9; P8=0= P9 IS NUM.
688	IF(Q(J+9).GT.0)CALL MMNN(9)
C FOUND A POS. IN P9
601	CONTINUE

	KPG=TTT+1
C KPG IS CURRENT NUM. OF STAVES. (ALWAYS START AT STAFF 0!!!!)

C NEXT SORTS THE POINTS
6000	J=1
CC610	IF(NN(J).NE.-16)GO TO 1610
C NEXT LOOKS FOR CONTINUATION OF TEXTS.(P10=1)  PUTS ALL AT SAME P3 LOC.
CC	K=MM(J)
CC	IF(Q(K-3).LT.8)GO TO 1610
CC	IF(Q(K+7).EQ.1)Q(K)=Q(MM(J-1))
CC	GO TO 710
CC1610	IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
610	IF(Q(MM(J)).LE.Q(MM(J+1)))GO TO 710
	CALL EXCHG(MM(J),NN(J))
C  ABOVE EXCHGS --(J) AND --(J+1)
	IF(J.EQ.1)GO TO 710
	J=J-1
	GO TO 610
710	J=J+1
	IF(J.LT.N)GO TO 610
C NOW ALL SORTED
	CALL FNDEND(R)
	CALL SHFTQ(R)
C  SHIFTS TO PROPER HORIZ. POS.
	IF(IPG)CALL RESTP
C  RESTP COMBINES LEFTOVER NUMBERED BARS OF RESTS. (FOR PARTS ONLY)
	IF(N.LE.0)GO TO 122
C N IS NEG IF ONLY RESTS ON THIS LINE.  GO BACK.

	DO 119 K=1,150
119	HH(K)=0
C  HH ARRAY WILL HOLD FINAL COMPOSITE.
	G(1)=0
	E(1)=0
	F(1)=0
	RN(1500)=0
	RN(2500)=0
	ST=0
C ST=STAFF NUM, T=TOTAL RHYTHMS, J=CNTR OF MAIN POS. ARRAY
C JJ=CNTR FOR 2ND POS. ARRAY, JJJ=CNTR FOR 3RD.
	KE=0
	J=1000
933	JJ=1500
	JJJ=2000
	T=0
	M=0
	A=0
	B=0

	DO 33 K=1,N
	IF(NORH(KK,K))GO TO 33
CC	KK=NN(K)
CC	IF(KK.EQ.0)GO TO 33
CC	IF(KK.EQ.4)GO TO 2133
CC	IF(KK.EQ.17)GO TO 2133
C SKIP OVER STAFF # TRAP WITH BARS, METER, KSIG.
CC	IF(KK.EQ.18)GO TO 2133
CC	IF(KK.GT.2)GO TO 33
2133	LL=MM(K)-3
	IF(KK.LE.2)GO TO 1133
	RH=.01
C RHYTHMIC VALUE OF BARLINE, METER, KSIG
CCC	IF(KK.NE.4)RH=.6
	GO TO 3133
1133	IF(Q(LL+2).NE.ST)GO TO 33
C JUMP IF NOT ON RIGHT STAFF
	RA=9
	IF(KK.EQ.2)RA=7
	IF(Q(LL).LT.RA-2)GO TO 33
C JUMP IF WDCNT IS TOO SHORT
	IF(KK.EQ.1)GO TO 433
	IF(Q(LL).LT.6)GO TO 433
C NEXT FOR NUMBERED RESTS - SETS RHYTH VALUE BASED ON NUMBER.
	RZ=Q(LL+8)
C IF >0, RZ =THE NUMBER, ELSE IT'S A WHOLE REST, CENTERED, ETC.
	IF(RZ.LE.0)GO TO 433
	Q(LL+7)=2
C 2 IS THE SMALLEST RHYTH VALUE FOR A NUMBERED REST (WAS 3)
	IF(RZ.LT.8)GO TO 433
	Q(LL+5)=-3
C IF NUMB. .GE.8 THEN PRINTS DBL WHOLE REST
	RZ=RZ/2.0
CC	RZ=IFIX(RZ/2.0)+1.0
	IF(RZ.GT.6)RZ=6
C LIMIT OF 8 ON RHYTH VAL.
	Q(LL+7)=RZ
433	RH=Q(LL+IFIX(RA))
	IF(RH.EQ.0)GO TO 33
3133	RZ=Q(LL+3)
	IF(ZERO(RZ,A).EQ.0)GO TO 133
C  JUMP IF THIS NOTE IN SAME POS. AS LAST ONE.
	RRH=RH
C SAVE RHYTH TO CHECK WITH OTHER IN SAME POS.
	TT=T
C SAVE TOTAL RHYTHM BEFORE THIS NOTE.
	J=J+1
C UPDATE COUNTER IN POSITION ARRAY
	T=T+RH
C ADD TO TOTAL RHYTHM
	RN(J)=T
	A=Q(LL+3)
C SAVE POS. OF THIS NOTE.
	GO TO 33
133	IF(RH.EQ.RHH)GO TO 33
C  IGNORE 2ND RHYTH IF SAME AS FIRST
	IF(ZERO(RZ,B).EQ.0)GO TO 333
C JUMP IF A THIRD DIFFERENT  RHYTHM IN SAME POS. (THIS IS THE LIMIT!)
	TTT=TT
C SAVE TOTAL RHYTHM TO THIS POINT.
	TT=TT+RH
	JJ=JJ+1
C UPDATE COUNTER FOR 2ND ARRAY
	RN(JJ)=TT
	RRRH=RH
	B=A
	GO TO 33
333	IF(RH.EQ.RRRH)GO TO 33
	TTT=TTT+RH
	JJJ=JJJ+1
	RN(JJJ)=TTT
33	CONTINUE
C NOW COMPARE THIS WITH BASIC RHYTHM ARRAY (STARTS AT RN(1001)
	IF(ST.NE.0)GO TO 733
	KE=J-999
C TOTAL NUM OF RHYTHMS ON STAFF1.
CC	IF(JPG.EQ.0)GO TO 2233
	IF(KPG.LE.1)GO TO 2233
C KPG=0=PARTS;    =1=PAGE, 1 STAFF
C  JUMP IF ONLY ONE STAFF
C****733	KF=J-2499
C KF=NUM OF RHYTHMS ON NEXT STAFF.  **** NEVER USED ****
733	ST=ST+1
	IF(ST.GT.1)GO TO 833
C JUMP IF ALL STAVES HAVE BEEN READ.
1233	J=2500
	GO TO 933
833	IF(J.NE.2500)GO TO 1533
C  JUMP IF THERE IS ONLY ONE LINE OF RHYTHM
C NOW LINE ONE STARTS AT RN(1001), LINE 2 AT RN(2501)

2233	CALL RLOOP(HH,E,KE)
C FOR SINGLE STAFF OF RHYTHM
	KL=KE
	GO TO 1333
1533	K=1
	L=1
	M=0
19	KK=K
	LL=L
1	SM=10000
	K=K+1
	IF(K.GT.KE)GO TO 10
4	L=L+1
	Y=F(L)
	B=Y-F(L-1)
	IF(B.LT.SM)SM=B
2	X=E(K)
	A=X-E(K-1)
C  A AND B HAVE TRUE DURATIONS NOW
	IF(A.LT.SM)SM=A
C SM = SMALLEST RHYTH VALUE BEFORE NEXT CONTACT
	IF(ZERO(X,Y).EQ.0)GO TO 3
C JUMP IF EQUAL RHYTHS
	IF(X.GT.Y)GO TO 4
	K=K+1
C STEP FORWARD UNTIL X IS .GT. Y
	GO TO 2
3	IF(K.NE.KK+1)GO TO 13
	IF(L.NE.LL+1)GO TO 14
	M=M+1
	G(M)=E(KK)
	GO TO 19
13	IF(L.NE.LL+1)GO TO 15
	DO 16 J=KK,K-1
	M=M+1
16	G(M)=E(J)
	GO TO 19
14	DO 17 J=LL,L-1
	M=M+1
17	G(M)=F(J)
	GO TO 19
15	XM=SM-.001
	M=M+1
	P=E(KK)
	G(M)=P
7	KK=KK+1
	LL=LL+1
	YM=SM*1.5
C THIS COULD BE *2 (NOTE /16/8./ VS. /6/12/ )
	S=P
	T=P
27	A=E(KK)
	B=F(LL)
	IF(ZERO(A,B).EQ.0)GO TO 19
	X=ZERO(A,P)
	Y=ZERO(B,P)
C  FUNCT. ZERO:  ZERO=B-P, IF(ABS(ZERO).LT..01)ZERO=0
	S=E(KK-1)
	T=F(LL-1)
9	IF(A-S.LT.X-.01)X=ZERO(A,S)
	IF(B-T.LT.Y-.01)Y=ZERO(B,T)
	IF(A.GT.B+.01)GO TO 8
	B=A
	KK=KK+1
62	IF(X.GT.YM)GO TO 5
	IF(X.EQ.0)GO TO 27
	P=P+SM
25	M=M+1
	G(M)=P
	GO TO 27
5	P=P+SM
	IF(P)GO TO 2203
C IF(P)ERROR
	IF(P.LT.B-.01)GO TO 5
	GO TO 25
8	X=Y
	LL=LL+1
	GO TO 62
10	M=M+1
	G(M)=E(KE)
CC	TYPE 410,(E(K),K=1,KE)
CC	TYPE 410,(F(K),K=1,KF)
CC	TYPE 410,(G(K),K=1,M)
CBCB	WRITE(21,410)(E(K),K=1,KE)
CB	WRITE(21,410)(F(K),K=1,KF)
CB	WRITE(21,410)(G(K),K=1,M)
410	FORMAT(10F7.2)
C NEXT SECTION SETS UP COMPLETE RHYTH COMPOSITE(NEGS. OR NON-SPC VALS.)
1033	JJ=1
	H(1)=0
	J=1
	K=2
	L=2
511	IF(J.EQ.M)GO TO 911
	J=J+1
	X=G(J)
1211	A=E(K)
	B=F(L)
	Y=ZERO(X,A)
	Z=ZERO(X,B)
	IF(A-B.GT..01)GO TO 1111
	IF(Y.EQ.0)GO TO 1311
	IF(X.LT.A-.01)GO TO 1111
	K=K+1
1411	JJ=JJ+1
	H(JJ)=-A
	GO TO 1211
1111	IF(Z.EQ.0)GO TO 1311
	IF(X.LT.B-.01)GO TO 1311
	L=L+1
	A=B
	GO TO 1411

1311	JJ=JJ+1
	H(JJ)=X
	IF(Y.EQ.0)GO TO 611
	IF(Z.EQ.0)GO TO 711
	IF(ZERO(A,B).EQ.0)GO TO 511
	P=A
	IF(P.GT.B+.01)GO TO 811
	IF(P.GT.X+.01)GO TO 511
	K=K+1
	GO TO 1011
811	P=B
	IF(P.GT.X+.01)GO TO 511
	L=L+1
1011	JJ=JJ+1
	H(JJ)=-P
C NON-SPACED RHYTHS ARE NEG.
	GO TO 511
611	K=K+1
	IF(Z.GT.0)GO TO 511
711	L=L+1
	GO TO 511
911	IF(HH(2).EQ.0)GO TO 2011
	K=2
	J=2
	L=1
	HHH(1)=0
1511	IF(J.GT.JJ)GO TO 1811
	P=H(J)
	A=ABS(P)
	B=ABS(HH(K))
	IF(ZERO(B,A).EQ.0)GO TO 1611
	IF(A.GT.B)GO TO 1711
	J=J+1
	GO TO 1911
1711	P=HH(K)
	GO TO 2211
1611	J=J+1
2211	K=K+1
1911	L=L+1
	HHH(L)=P
	GO TO 1511
2011	CALL RLOOP(HH,H,JJ)
	KL=JJ
	GO TO 2111
1811	CALL RLOOP(HH,HHH,L)
	KL=L
2111	IF(ST.GE.KPG)GO TO 1333
	CALL RLOOP(E,G,M)
	KE=M
C GO WAY BACK AND READ ANOTHER LINE.
	GO TO 1233
1333	E(1)=0
	GO TO 2333
	TYPE 410,(HH(K),K=1,KL)
	WRITE(21,410)(HH(K),K=1,KL)
2333	JD=1
C JD IS COUNTER FOR DUMMY POSITIONS.
	DUMMY(1)=1
	ST=0
183	B=0
	LL=2

	DO 181 K=1,N
	IF(NORH(L,K))GO TO 181
C LOOK FOR DUMMY RHYTHMS.
	IF(L.LE.2)GO TO 2184
	RZ=.01
C  RHYTHMIC VALUE OF BAR, METER, KSIG.  CHANGED TO ABS. SIZE LATER.
	GO TO 1184
2184	LF=MM(K)
	IF(Q(LF-1).NE.ST)GO TO 181
C FOUND RHYTH ON RIGHT STAFF (LF PNTS TO PARAM 3)
	J=6
	IF(L.EQ.2)J=4
	RZ=Q(LF+J)
1184	B=B+RZ
184	V=ABS(HH(LL))
	IF(ZERO(B,V).GT.0)GO TO 182
C FOUND RHYTH MATCH
	JD=JD+1
	DUMMY(JD)=LL
	LL=LL+1
	GO TO 181
182	IF(B.LT.V-.01)GO TO 181
	LL=LL+1
	GO TO 184
181	CONTINUE
	ST=ST+1
	IF(ST.LT.KPG)GO TO 183

C NEXT SORT DUMMY ARRAY
	J=0
185	DO 186 K=2,JD
	IF(DUMMY(K).NE.DUMMY(K-1))GO TO 187
	DO 188 LL=K,JD
188	DUMMY(LL-1)=DUMMY(LL)
	JD=JD-1
	GO TO 185
187	IF(DUMMY(K).GT.DUMMY(K-1))GO TO 186
	CALL EXCH(DUMMY(K),DUMMY(K-1))
	GO TO 185
186	CONTINUE
C NOW DUMMY CONTAINS ALL NON-DUMMY RHYTHS!!!
	PX=0
	LF=0
	K=1
	V=0

81	K=K+1
	IF(K.GT.KL)GO TO 1433
	B=HH(K)
	A=B-V
	V=B
	IF(V)GO TO 82
85	W=V
	IF(A.GT.0.011)GO TO 89
C  .GT. BECAUSE OF ROUND-OFF ERROR   (WAS 0.01 ABOVE AND BELOW 10/79)
	T=5
	IF(HH(K+1)-V.LE.0.011)T=2
	PX=PX+T
C THIS FOR BARS, KSIG, METER
	GO TO 189
89	PX=PX+14.0*EXP(ALOG(A)*0.5849624)
C THIS IS EXP((ALOG(A)/ALOG(2.0))*ALOG(1.5))  NOT FIBBONACI (1.618)
CC89	PX=PX+PFIBX(A)
189	E(K)=PX
	IF(LF.NE.0)GO TO 86
	GO TO 81
82	LF=K
83	K=K+1
	V=HH(K)
	IF(V)GO TO 83
	A=V-W
	GO TO 85
86	LL=LF-1
	D=E(K)-E(LL)
87	S=-HH(LF)-HH(LL)
	T=HH(K)-HH(LL)
	T=S/T
C  THIS FINDS POS OF NON-IMPORTANT RHY BETWEEN IMPORTANT ONES.
	E(LF)=E(LL)+D*T
	LF=LF+1
	IF(LF.NE.K)GO TO 87
	LF=0
	GO TO 81

1433	GO TO 2433
	TYPE 410,(E(K),K=1,KL)
	WRITE(21,410)(E(K),K=1,KL)
C  5 IS SPACE AFTER 1ST BARLINE
2433	IF(Q(2).EQ.18)RNEXT=RNEXT-3.6
C PUSH CLOSER TO PREVIOUS BARLINE IF 1ST ITEM IS METER 
	R8=RNEXT
C POS OF 1ST BAR = END OF PREV. LINE
     	IF(ENDLN.EQ.0)RNEXT=9
C  MAKES ROOM FOR 1ST CLEF.
	KL=KL-1
	J=0
	R5=0
	KK=1
	JD=1
	W=0
	LF=0

	DO 80 K=1,N
	IF(NORH(L,K))GO TO 80
	A=Q(MM(K))
	IF(ZERO(A,W).EQ.0)GO TO 80
C  SKIP IF SAME POS OF NOTE OR REST.
	W=A
	R7=R8
190	J=J+1
	IF(J.LE.KL)GO TO 290
203	FORMAT(' FOUND CENTERED WHOLE REST!')
2203	LL=0
	IF(JCEN.GE.0)GO TO 220
	TYPE 203
	GO TO 121
220	JJJ=-1
	L=0
120	W=LL
	A=0
	DO 124 KB=1,N
	LF=NN(KB)
	IF(LF.GT.2)GO TO 124
	IF(LF.LE.0)GO TO 124
	KE=MM(KB)
	IF(Q(KE-1).NE.W)GO TO 124
C ADD UP RHYTHMIC VALUES ON EACH SEPARATE LINE.
	JD=6
	IF(LF.EQ.2)JD=4
	A=A+Q(KE+JD)
124	CONTINUE
	TYPE 123,LL,A
	LL=LL+1
	IF(L.EQ.0)L=A*100.+.5
C  SAVE NUM. OF BEATS FIRST TIME.
	IF(L.NE.A*100.+.5)JJJ=0
C SET FLAG IF MISMATCH. (JJJ=0=MISMATCH, =-1=MISALIGNED)
	IF(LL.LT.KPG)GO TO 120
	IF(JJJ.NE.0)GO TO 121
	JJJ=0
	DO 320 KB=2,JJ
	A=HH(KB)-HH(KB-1)
	IF(A.LE..01)GO TO 320
C  SKIP BAR LINE VALUES (.01)
	JJJ=JJJ+1
	HH(JJJ)=4./A
C THIS WILL PRINT SMALLEST COMPOSITE RHYTHM
320	CONTINUE
	TYPE 420,(HH(KB),KB=1,JJJ)
	PAUSE
	1' ****COMPOSITE RHYTHM ERROR - AND/OR MISALIGNED NOTES****'
	GO TO 90
420	FORMAT(10F8.2)
123	FORMAT(' STF',I2,' =',F9.5,' QTRS')
121	PAUSE' *****RHYTHM MISMATCH*****'
	GO TO 90
290	IF(DUMMY(JD).NE.J)GO TO 190
	JD=JD+1
90 	R8=RNEXT+E(J)
	R4=R5
	R5=A
	X=(R8-R7)/(R5-R4)
	S=R7-R4*X
	DO 91 L=KK,K
	LL=MM(L)
91	Q(LL)=S+X*Q(LL)
	KK=K+1
80	CONTINUE

CCC	IF(KK.GT.K)GO TO 180
	IF(KK.GT.N)GO TO 180
C THIS FOR ITEMS BEYOND LAST IMPORTANT ITEM.
	R7=Q(LL)-R5
C R7=NEW POS. OF LAST IMPORTANT ITEM. R5=OLD POS.
CCC	DO 280 L=KK,K
	DO 280 L=KK,N
	LL=MM(L)
280	Q(LL)=R7+Q(LL)
180	JJ=JJ2-2
	L=JJ2
	M=0
C FLAG FOR REST AT START OF LINE

	JJJ=-1
C FLAG FOR 1ST BAR OF LINE 12/77
	V=0
	ACCI=0
	DO 12 J=1,JJ
	   R=CODEN(KPN,J,Q,LA)
CC	   IF(CODEN(KPN,J,Q,LA).NE.4)GO TO 12
	   IF(R.EQ.4)GO TO 680
	   IF(M)GO TO 780
	   IF(R.NE.2)GO TO 780
C NEXT FOR RESTS
	   ACCI=ACCI+.5
C  ADD A LITTLE FOR TOTAL NUM. OF NOTES AND RESTS.
C SHOULD WE ALSO CONSIDER CLEFS??  MAYBE ADD LATER.
	   IF(KBR.EQ.0)GO TO 12
C  LOOK FOR RESTS AT FRONT OF LINE.
	   X=0
	   CALL TURN(J,JJ,1,X)
	   PGTRN(KBR)=PGTRN(KBR)+X
	   M=-1
	   
780	   IF(R.NE.1)GO TO 12
	   IF(V.NE.Q(LA+3))GO TO 782
           IF(JACC)GO TO 781
782	   ACCI=ACCI+.5
   	   IF(AMOD(Q(LA+5),10.0).EQ.0)GO TO 781
	   JACC=-1
	   V=1
C KPG=NUMB. OF STAVES BEING CONSIDERED. (IF 1, THEN ALL ACCIS ARE 'BIG')
	   IF(KPG.GT.1)V=RSTFAC(IFIX(Q(LA+2))+1)
CCCC	V=RSTFAC(IFIX(Q(LA+2))+1)
CC	ACCI=ACCI+ACCISZ*RSTFAC(IFIX(Q(LA+2)))
CCCC	ACCI=ACCI+ACCISZ*V
  	   ACCI=ACCI+V
C  ADD SPACE FOR ACCIDENTALS*STAFF SIZE -- SEE DATA FOR ACCISZ.
	   V=Q(LA+3)
781	   M=-1
	   IF(NOGRCE)GO TO 12
C NEXT TO GIVE EQUAL SPACE FOR EVERY GRACE NOTE
C FOUND A NOTE
C*************************	   IF(Q(LA+9).GT.0.05)GO TO 12 
	IF(Q(LA+9).NE.4.0/88.0)GO TO 12
C JUMP IF NOT A GRACE NOTE
	   R=Q(LA+2)
C  THE STAFF NUM.
	   DO 580 LF=J+1,JJ
	   	IF(CODEN(KPN,LF,Q,JD).NE.1)GO TO 580
		IF(Q(JD+2).NE.R)GO TO 580
	   	IF(Q(JD).LT.7)GO TO 580
	   	IF(Q(JD+9).EQ.0)GO TO 580
C   CHORD NOTE
  	   	R4=Q(LA+3) 
CC	   	R4=Q(LA+3)-1 
	   	R5=Q(JD+3)
C  THE STAFF # IS IN R2
	   	R8=RSTFAC(IFIX(R2+1))+.5
	   	IF(Q(JD+4).LT.80)R8=R8*2  
C  INSURES SPACE BETWEEN GRACE NOTE AND NEXT NOTE
	   	R8=R5-R8
CC	   	R8=R5-R8-1
CCC	   	IF(R4.EQ.R5)GO TO 12
	   	IF(R4.NE.R5)GO TO 480
C  GRACE NOTE AT START OF LINE ***** FIX THIS????
		DO 880 KE=1,LF-1
880		Q(KPN(KE)+3)=R8
C  MOVE THE GRACE NOTE, AND OTHER STUFF, TO LEFT.
	   	GO TO 12
480	   	R2=Q(LA+2)
	   	R9=R5
	   	CALL PTMOVE(Q,KPN)
CC	   	TYPE 9999,Q(J+3),Q(JD+3)
CC9999	   	FORMAT(2F)
	   	GO TO 12 
580	   CONTINUE
	   GO TO 12
C  ABOVE FOR GRACE NOTE SPACING.
680	   KBR=KBR+1
C BAR LINE COUNTER
	   T=Q(LA+3)
C TOTAL SPACE
	   X=0
	   CALL TURN(J-1,1,-1,X)
	   CALL TURN(J+1,JJ,1,X)
222	   PGTRN(KBR)=X
C FINDS PAGE-TURN POSSIBILITIES
C CHANGE ALL VALUES TO 4/5 OF THEIR CURRENT SIZE.
	   BFAC=.8
CCC	   BFAC=.756
	   IF(KPG.GT.1)CALL BARFAC(KPG,BFAC,JK)
CC	   IF(KPG.LE.1)GO TO 3112
C DO NEXT IF MORE THAN 1 STAFF(KPG) AND DIFF. SIZE FACTORS ARE FOUND.
CC	   R=RSTFAC(1)
CC	   DO 5112 K=2,KPG
CC5112	   IF(R.NE.RSTFAC(K))GO TO 6112
CC	   GO TO 3112
C NEXT TO FIND PROBABLE SIZE FACTOR FOR THIS BAR. (NOT FOR PARTS)
C  FIND LINE WITH MOST ACTIVITY.
C  ALL THIS SORT OF WORKS.  SOMEDAY REVIEW IT.********
CC6112	   DO 1112 K=1,8
CC1112	   RN(K)=0
CC	   DO 112 K=JK,J-1
CC	   R=CODEN(KPN,K,Q,JD)
CC	   IF(R.GT.3.)GO TO 112
CC	   A=1.0
C CHECKS FOR NUMBER OF NOTES, RESTS, CLEFS.
CC	   IF(R.EQ.2)A=0.6
C SKIP NON-RHYTHM CHORD NOTES.   RESTS ARE CONSIDERED LESS IMPORTANT.
CC	   IF(R.NE.1)GO TO 4112
CC	   IF(Q(JD).LT.7)GO TO 112
CC	   IF(Q(JD+9).LE.0)GO TO 112
CC4112	   LF=Q(JD+2)+1
CC	   RN(LF)=RN(LF)+A 
CC112	   CONTINUE
CC	   JD=1
CC	   B=RN(1)*RSTFAC(1)
CC	   DO 2112 K=2,8
CC	   A=RN(K)*RSTFAC(K)
CC  	   IF(A.LE.B)GO TO 2112
CC	   JD=K
CC	   B=A
CC2112	   CONTINUE
CC	   BFAC=BFAC*(RSTFAC(JD)+.1)
C +.1 ABOVE TO MINIMIZE DIFF. IN SIZE FACTOR.
CXX	   BFAC=.84*RSTFAC(JD)
3112	   IF(JJJ)RNEXT=RNEXT-6
C JJJ=-1 IF 1ST BAR OF LINE. 12/77
	   JJJ=0
	   BARS(KBR)=(T-RNEXT+ACCI)*BFAC
C SIZE OF THIS MEASURE + ACCISZ*ACCIDENTALS
	   ACCI=0
C RESET ACCI (SPACE FOR ACCIS AND TOTAL NUM. OF NOTES)
	   K=J
	   JK=J+1
C SET UP POINTER FOR NEXT BAR'S ITEMS.
	   RNEXT=T
12	CONTINUE

	IF(K.NE.JJ)RNEXT=Q(KPN(JJ)+3)
	RNEXT=RNEXT+5
CCC 11/9/78	RNEXT=RNEXT+3
	JJ2=L 
C JJ2 GETS WIPED OUT IN PTMOVE, SO GET IT BACK HERE
CC???380	LCNT=0
CC???	NDPY=0

C JJ2 IS END OF PNTR DATA
11	IF(IPG.EQ.2)NMPG=NAMX
C IPG=2=REORDER INPUT FILE ONLY.
	JPQ=KPN(JJ2-1)+1
	CALL PUTEXT(NMPG,'PAG')
	CALL EXTOUT(RSTFAC,128)
C*** 	CALL EXTOUT(PN,JJ2)
C NEW SAVE FORMAT DOESN'T NEED ABOVE 3/80
	CALL EXTOUT(Q,JPQ)
	IF(IPG.EQ.2)CALL EXIT
	CALL FINEXT

	LASTNM=NMPG
	NMPG=NMPG+2
	IF(NMPG.EQ.'PAGEZ'+2)NMPG='PAGFA'
C  WILL GO FROM PAGEA TO PAGFZ, ETC. (104)  ADD TO THIS IF NEEDED.
	IF(NMPG.EQ.'PAGFZ'+2)NMPG='PAGGA'
	IF(NMPG.EQ.'PAGGZ'+2)NMPG='PAGHA'
122	ENDLN=RNEXT
	END